Notifications
Clear all

Confrontar células em VBA

21 Posts
3 Usuários
0 Reactions
2,895 Visualizações
(@rtesteves)
Posts: 11
Active Member
Topic starter
 

Bom dia pessoal,

Como vocês fariam em VBA, por exemplo:

Tenho duas abas (Dados e Transf) na aba Dados eu já tenho informações nas colunas A1 (NF), B1 (Tipo), C1 (Nome) e informações nestas respectivas colunas. E na aba Transf eu tenho os "mesmos conteúdos de informações" é aí que eu queria um código para verificar as informações que estão na aba Transf com a Dados. A aba Dados será alimentada diariamente com novas informações mas eu quero verificar através da aba Transf que SE as informações que eu tenho na aba Transf for diferentes da aba Dados ela irá acrescentar no final em novas linhas senão ela não copia nada ou copia parcialmente o que não é repetido. a coluna chave seria a A(NF) que não pode ser igual e só irá copiar alguns tipos específicos, ex: 60, 120, 141 constantes na coluna B. Eu queria que fizesse tudo de uma só vez, se tiver 20 linhas na aba Transf ele já verificaria tudo e copiasse se estivesse dentro do critério.

Segue em anexo o arquivo modelo.

Aguardo ajuda.
Obrigado.

 
Postado : 11/12/2013 9:22 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Eu queria contar as copias para o destino, ex: "Foram copiadas XX de linhas para a plan Dados!"

Faça assim...

MsgBox "Foram copiadas " & Sheets("Dados").Range("A1").End(xlDown).Row & " Linhas"

Outro detalhe, desculpe minha ignorância mas se eu precisar aumentar mais colunas para confrontar(D, E, F....) como faço?

Tente..alterar

.Range(.Cells(2, "A"), .Range("F" & Rows.Count).End(xlUp)).Copy 

Não testado!!!!!!!!!
Código:

Sub Filter_Coluna()

Dim rCrit As Range
Dim aCrit
'With Sheets("Dados")
'.Range("A2:D50000").ClearContents
'End With
Application.ScreenUpdating = 0
With Sheets("Plan3")
  Set rCrit = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
  aCrit = Split(Join(Application.Transpose(rCrit), Chr(1)), Chr(1))
End With
With Sheets("Transf")
  .Range("$B$1:$B$50000").AutoFilter Field:=1, Criteria1:=aCrit, Operator:=xlFilterValues
  .Activate
  .Range(.Cells(2, "A"), .Range("F" & Rows.Count).End(xlUp)).Copy Destination:=Sheets("Dados").Range("A" & Rows.Count).End(xlUp).Offset(1)
  .ShowAllData
  End With
  Call Duplic_AleVBA_9890
  Application.ScreenUpdating = 1
  MsgBox "Foram copiadas " & Sheets("Dados").Range("A1").End(xlDown).Row & " Linhas"
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 11/12/2013 2:07 pm
(@rtesteves)
Posts: 11
Active Member
Topic starter
 

Sobre as colunas vou ter que testar num outro momento com calma. Mas sobre a mensagem não deu certo, ele contou quantas linhas tem total na guia Dados e não quantas foram copiadas naquele momento que é o que eu queria.

Aguardo,

Abs.

 
Postado : 11/12/2013 2:33 pm
(@rtesteves)
Posts: 11
Active Member
Topic starter
 

Bom dia Alexandre !! Testei inserindo informações nas colunas seguintes da Guia Dados sem mexer nos códigos, mas o código no módulo duplicidade ele bagunça as informações da guia Dados das colunas seguintes. Minha pergunta é: Será possível criar uma condição "Se já existe os dados não mexer nas células"? Por que este controle que preciso ele será alimentado com as esta verificação automática e também com informação na coluna seguinte com uma observação manual do usuário. Então tenho que manter na ordem ambas as situações.

Aguardo, obrigado.

 
Postado : 12/12/2013 6:41 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Depois eu veja a questão das colunas.

Por hora veja se a MsgBox dessa rotina te ajuda.

Sub Filter_Coluna()

Dim rCrit As Range
Dim aCrit

Application.ScreenUpdating = 0
With Sheets("Plan3")
  Set rCrit = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
  aCrit = Split(Join(Application.Transpose(rCrit), Chr(1)), Chr(1))
End With
With Sheets("Transf")
     .Range("$B$1:$B$50000").AutoFilter Field:=1, Criteria1:=aCrit, Operator:=xlFilterValues
     .Range(.Cells(2, "A"), .Range("C" & Rows.Count).End(xlUp)).Copy Destination:=Sheets("Dados").Range("A" & Rows.Count).End(xlUp).Offset(1)
     Rg = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count
     .ShowAllData
End With

  Call Duplic_AleVBA_9890
  Application.ScreenUpdating = 1
  MsgBox "Foram copiadas " & Rg & " Linhas"
 
End Sub

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 12/12/2013 8:00 am
(@rtesteves)
Posts: 11
Active Member
Topic starter
 

Boa tarde Alexandre, estava bem corrido pra mim mas quero agradecer a atenção que você deu e lhe retornar que sua ajuda foi fundamental para eu alcançar o objetivo. Quero compartilhar com você este código abaixo que junto com o seu fez a minha planilha funcionar 1000% !!

(Fonte de um site estrangeiro)
Código que elimina células duplicadas sem alterar as células preenchidas para cima na planilha.

Sub DeletDuplicate()
    Dim x As Long
    Dim LastRow As Long
    
    ThisWorkbook.Worksheets("Plan1").Activate
    
    LastRow = Range("A65536").End(xlUp).Row
    For x = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
            Range("A" & x).EntireRow.Delete
        End If
    Next x
    
    MsgBox "Pronto para uso !"
End Sub
 
Postado : 19/12/2013 12:48 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Eu fico feliz por você ter resolvido sua dúvida!!

Att :D

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 19/12/2013 1:07 pm
Página 2 / 2